home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / pntr_v1.zip / DISPLAY.PAS < prev    next >
Pascal/Delphi Source File  |  1991-10-26  |  4KB  |  168 lines
  1. PROGRAM Display;
  2. { Displays picture files.
  3.   DISPLAY filename [mode] [/BW] }
  4. USES Crt,Dos;
  5. VAR Param,Mode : String;
  6.  
  7.   PROCEDURE Bright(Switch : Boolean);
  8.   VAR Reg : Registers;
  9.   BEGIN
  10.     WITH Reg DO
  11.     BEGIN
  12.       If Switch then BL := 0 else BL := 1;
  13.       AX := $1003;
  14.     END;
  15.     Intr($10,Reg);
  16.   END;
  17.  
  18.   PROCEDURE HideCursor;
  19.   VAR Reg : Registers;
  20.   BEGIN
  21.     WITH Reg DO
  22.     BEGIN
  23.       ch := 7;
  24.       cl := 1;
  25.       ah := 1;
  26.       Intr($10,Reg);
  27.     END;
  28.   END;
  29.  
  30.   PROCEDURE UnHideCursor;
  31.   VAR Reg : Registers;
  32.   BEGIN
  33.     WITH Reg DO
  34.     BEGIN
  35.       ch := 6;
  36.       cl := 7;
  37.       ah := 1;
  38.       Intr($10,Reg);
  39.     END;
  40.   END;
  41.  
  42.   PROCEDURE BumpStrup(VAR s : String);
  43.   VAR i : Byte;
  44.   BEGIN
  45.     For i := 1 to Length(s) do
  46.       s[i] := UpCase(s[i]);
  47.   END;
  48.  
  49.   PROCEDURE PAK;
  50.   VAR CH:Char;
  51.   BEGIN
  52.     REPEAT UNTIL KeyPressed;
  53.     ch:=Readkey;
  54.   END;
  55.  
  56.   PROCEDURE ShowPic(Filename : String;Top,Bottom : Byte;Mode : String);
  57.   VAR i,j : Byte;
  58.       TextVar : Text;
  59.       Painting : ARRAY[1..25,1..160] of Char;
  60.   BEGIN
  61.     TextColor(White);
  62.     TextBackground(Black);
  63.     ClrScr;
  64.     Assign(TextVar,Filename);
  65.     {$I-} Reset(TextVar); {$I+}
  66.     If IoResult<>0 then
  67.     BEGIN
  68.       TextColor(LightGray);
  69.       Writeln('Display 1.0 - Picture viewer for Painter 1.0');
  70.       Writeln('Copyright 1991 (c), CDS Productions, Carlos da Silva');
  71.       Writeln;
  72.       Param := ParamStr(1);
  73.       {$V-} BumpStrup(Param); {$V+}
  74.       Writeln('File not found -- ',Param);
  75.       Bright(False);
  76.       UnHideCursor;
  77.       Halt(2);
  78.     END;
  79.     Filename := Filename;
  80.     For i := 1 to 25 do
  81.     BEGIN
  82.       For j := 1 to 160 do
  83.         Read(TextVar,Painting[i,j]);
  84.       Readln(TextVar);
  85.     END;
  86.     Close(TextVar);
  87.     If Mode='2' then
  88.     BEGIN
  89.       For i := Bottom downto Top do
  90.         For j := 1 to 80 do
  91.         BEGIN
  92.           GotoXY(j,i);
  93.           TextAttr := Ord(Painting[i,(j*2)-1]);
  94.           Write(Painting[i,(j*2)]);
  95.         END;
  96.     END else
  97.     If Mode='3' then
  98.     BEGIN
  99.       For j := 1 to 80 do
  100.         For i := Top to Bottom do
  101.         BEGIN
  102.           GotoXY(j,i);
  103.           TextAttr := Ord(Painting[i,(j*2)-1]);
  104.           Write(Painting[i,(j*2)]);
  105.         END;
  106.     END else
  107.     If Mode='4' then
  108.     BEGIN
  109.       For j := 80 downto 1 do
  110.         For i := Top to Bottom do
  111.         BEGIN
  112.           GotoXY(j,i);
  113.           TextAttr := Ord(Painting[i,(j*2)-1]);
  114.           Write(Painting[i,(j*2)]);
  115.         END;
  116.     END else
  117.     BEGIN
  118.       For i := Top to Bottom do
  119.         For j := 1 to 80 do
  120.         BEGIN
  121.           GotoXY(j,i);
  122.           TextAttr := Ord(Painting[i,(j*2)-1]);
  123.           Write(Painting[i,(j*2)]);
  124.         END;
  125.     END;
  126.   END;
  127.  
  128. BEGIN
  129.   Bright(True);
  130.   HideCursor;
  131.   Writeln('Display 1.0 - Picture viewer for Painter 1.0');
  132.   Writeln('Copyright 1991 (c), CDS Productions, Carlos da Silva');
  133.   Writeln;
  134.   If ParamCount=0 then
  135.   BEGIN
  136.     Writeln('Incorrect usage.');
  137.     Writeln('Command format is: DISPLAY filename [mode] [/BW]');
  138.     Writeln;
  139.     Writeln('filename is the picture to view.  It is required.');
  140.     Writeln('[mode] is the way to display it.');
  141.     Writeln('  *1 - Top to bottom wipe');
  142.     Writeln('   2 - Bottom to top wipe');
  143.     Writeln('   3 - Left to right wipe');
  144.     Writeln('   4 - Right to left wipe');
  145.     Writeln;
  146.     Writeln('/BW - Display it in black and white.');
  147.     Writeln;
  148.     Writeln('*(Default value)');
  149.     Bright(False);
  150.     UnHideCursor;
  151.     Halt(1);
  152.   END;
  153.   Param := ParamStr(2);
  154.   {$V-} BumpStrup(Param); {$V+}
  155.   If Param='/BW' then
  156.   BEGIN
  157.     TextMode(MONO);
  158.     Mode := '1';
  159.   END else Mode := Param;
  160.   If ParamStr(3)='/BW' then TextMode(MONO);
  161.   ShowPic(ParamStr(1),1,24,Mode);
  162.   PAK;
  163.   TextMode(CO80);
  164.   Bright(False);
  165.   UnHideCursor;
  166. END.
  167.  
  168.